home *** CD-ROM | disk | FTP | other *** search
/ An Invitation to the Roland World of Music / Roland - An Invitation To The Roland World Of Music.bin / vb / msgblast / mouseptr.frm < prev    next >
Text File  |  1994-04-23  |  9KB  |  254 lines

  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Custom Cursors in VB Example"
  5.    ClientHeight    =   4944
  6.    ClientLeft      =   1188
  7.    ClientTop       =   468
  8.    ClientWidth     =   6552
  9.    Height          =   5364
  10.    Left            =   1140
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4944
  13.    ScaleWidth      =   6552
  14.    Top             =   96
  15.    Width           =   6648
  16.    Begin CommandButton cmdQuit 
  17.       Caption         =   "Quit"
  18.       Default         =   -1  'True
  19.       Height          =   372
  20.       Left            =   3000
  21.       TabIndex        =   8
  22.       Top             =   4320
  23.       Width           =   972
  24.    End
  25.    Begin PictureBox Picture3 
  26.       DragIcon        =   MOUSEPTR.FRX:0000
  27.       Height          =   432
  28.       Left            =   5040
  29.       Picture         =   MOUSEPTR.FRX:0302
  30.       ScaleHeight     =   408
  31.       ScaleWidth      =   408
  32.       TabIndex        =   5
  33.       Top             =   4320
  34.       Visible         =   0   'False
  35.       Width           =   432
  36.    End
  37.    Begin MsgBlaster Msg3 
  38.       Prop8           =   "Click on ""..."" for the About Box ---->"
  39.       Prop9           =   "Click on ""..."" for the Message Center --->"
  40.       Left            =   4620
  41.       MsgList         =   MOUSEPTR.FRX:0604
  42.       MsgPassage      =   MOUSEPTR.FRX:0668
  43.       TargetName      =   "Text1"
  44.       Top             =   4320
  45.       UserMsgs        =   MOUSEPTR.FRX:069A
  46.       Version         =   "2.0"
  47.    End
  48.    Begin PictureBox Picture2 
  49.       DragIcon        =   MOUSEPTR.FRX:0A37
  50.       Height          =   432
  51.       Left            =   3120
  52.       Picture         =   MOUSEPTR.FRX:0D39
  53.       ScaleHeight     =   408
  54.       ScaleWidth      =   408
  55.       TabIndex        =   4
  56.       Top             =   3840
  57.       Visible         =   0   'False
  58.       Width           =   432
  59.    End
  60.    Begin MsgBlaster Msg2 
  61.       Prop8           =   "Click on ""..."" for the About Box ---->"
  62.       Prop9           =   "Click on ""..."" for the Message Center --->"
  63.       Left            =   2760
  64.       MsgList         =   MOUSEPTR.FRX:103B
  65.       MsgPassage      =   MOUSEPTR.FRX:109F
  66.       TargetName      =   "Check1"
  67.       Top             =   3840
  68.       UserMsgs        =   MOUSEPTR.FRX:10D1
  69.       Version         =   "2.0"
  70.    End
  71.    Begin CheckBox Check1 
  72.       BackColor       =   &H00C0C0C0&
  73.       Caption         =   "Star"
  74.       Height          =   252
  75.       Left            =   2700
  76.       TabIndex        =   3
  77.       Top             =   3600
  78.       Width           =   1332
  79.    End
  80.    Begin TextBox Text1 
  81.       Height          =   732
  82.       Left            =   4320
  83.       TabIndex        =   2
  84.       Text            =   "This one will have a face"
  85.       Top             =   3540
  86.       Width           =   2172
  87.    End
  88.    Begin ListBox List1 
  89.       BackColor       =   &H00FFFF00&
  90.       Height          =   1176
  91.       Left            =   660
  92.       TabIndex        =   1
  93.       Top             =   3600
  94.       Width           =   1872
  95.    End
  96.    Begin MsgBlaster Msg1 
  97.       Prop8           =   "Click on ""..."" for the About Box ---->"
  98.       Prop9           =   "Click on ""..."" for the Message Center --->"
  99.       Left            =   300
  100.       MsgList         =   MOUSEPTR.FRX:146E
  101.       MsgPassage      =   MOUSEPTR.FRX:14D2
  102.       TargetName      =   "List1"
  103.       Top             =   4440
  104.       UserMsgs        =   MOUSEPTR.FRX:1504
  105.       Version         =   "2.0"
  106.    End
  107.    Begin PictureBox Picture1 
  108.       DragIcon        =   MOUSEPTR.FRX:18A1
  109.       Height          =   432
  110.       Left            =   180
  111.       Picture         =   MOUSEPTR.FRX:1BA3
  112.       ScaleHeight     =   408
  113.       ScaleWidth      =   408
  114.       TabIndex        =   0
  115.       Top             =   3960
  116.       Visible         =   0   'False
  117.       Width           =   432
  118.    End
  119.    Begin Label Label3 
  120.       Caption         =   "A couple of other things. Make sure the icons you use are black and white or transparent only. Color will have unpredictable results. Windows doesn't know how to deal with color cursors. Also, don't use .CUR files, they won't work."
  121.       Height          =   792
  122.       Left            =   240
  123.       TabIndex        =   9
  124.       Top             =   2700
  125.       Width           =   6192
  126.    End
  127.    Begin Label Label2 
  128.       Caption         =   "This example is copyright 1994 Ed Staffin. See the about box on the Message Blaster for details."
  129.       Height          =   432
  130.       Left            =   1380
  131.       TabIndex        =   7
  132.       Top             =   60
  133.       Width           =   4152
  134.    End
  135.    Begin Label Label1 
  136.       BackColor       =   &H00FFFF80&
  137.       Caption         =   "In this example I used 3 Message Blasters, 3 Picture Boxes and 3 different icons. I used the msgcenter property to set the target window to the controls that I want a custom cursor for and trapped the WM_SETCURSOR message. I made sure that the message was eaten as opposed to the default (Post Process).  Then I set the DragIcon property of the picture boxes to the icon I wanted to used as a cursor. I then made sure the picture box's visible property was set to false. Next, just to make it easier to tell which is which, I set the picture property of the picture box to my icon. Then is was just a matter of catching the WM_SETCURSOR and doing a SetCursor API call. Check the Message event for details."
  138.       Height          =   1992
  139.       Left            =   240
  140.       TabIndex        =   6
  141.       Top             =   600
  142.       Width           =   6192
  143.    End
  144. End
  145. Option Explicit
  146. Declare Function SetCursor Lib "User" (ByVal hCursor As Integer) As Integer
  147. Declare Function DefWindowProc Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  148.  
  149. Sub cmdQuit_Click ()
  150.     End
  151. End Sub
  152.  
  153. Sub Form_Load ()
  154.     Dim i%
  155.  
  156.     For i = 1 To 15
  157.     list1.AddItem "Bang " & i
  158.     Next i
  159.  
  160. End Sub
  161.  
  162. Function HIWORD (l As Long) As Integer
  163.     ' Change the As Integer to As Long
  164.     ' if you need unsigned results
  165.     HIWORD = CInt((l And &HFFFF0000) \ &H10000)
  166. End Function
  167.  
  168. Function LOWORD (l As Long) As Integer
  169.     ' Change the As Integer to As Long
  170.     ' if you need unsigned results
  171.     LOWORD = l And &HFFFF&
  172. End Function
  173.  
  174. Sub Msg1_Message (MsgVal As Integer, wParam As Integer, lParam As Long, ReturnVal As Long)
  175.     '  copyright 1994 Ed Staffin
  176.     Const HTCLIENT = 1
  177.     Dim rc%
  178.     
  179.     ' The IF statement checks to see if the DragIcon
  180.     ' property of your PicturBox was non-NULL, and that
  181.     ' the cursor is over the client area,
  182.     ' (low word of lParam == 1 when cursor is there).
  183.     ' If you leave off the "else" statement then the
  184.     ' cursor will not be appropriate for the borders or
  185.     ' caption.
  186.     
  187.     Select Case MsgVal
  188.     Case WM_SETCURSOR
  189.         If (LOWORD(lParam) = HTCLIENT) And (Picture1.DragIcon) Then
  190.         rc% = SetCursor(Picture1.DragIcon)
  191.         ReturnVal = True
  192.         Else
  193.         ReturnVal = DefWindowProc((Msg1.hWndTarget), MsgVal, wParam, lParam)
  194.         End If
  195.  
  196.     End Select
  197.  
  198. End Sub
  199.  
  200. Sub Msg2_Message (MsgVal As Integer, wParam As Integer, lParam As Long, ReturnVal As Long)
  201.     '  copyright 1994 Ed Staffin
  202.     Const HTCLIENT = 1
  203.     Dim rc%
  204.     
  205.     ' The IF statement checks to see if the DragIcon
  206.     ' property of your PicturBox was non-NULL, and that
  207.     ' the cursor is over the client area,
  208.     ' (low word of lParam == 1 when cursor is there).
  209.     ' If you leave off the "else" statement then the
  210.     ' cursor will not be appropriate for the borders or
  211.     ' caption.
  212.     
  213.     Select Case MsgVal
  214.     Case WM_SETCURSOR
  215.         If (LOWORD(lParam) = HTCLIENT) And (Picture2.DragIcon) Then
  216.         rc% = SetCursor(Picture2.DragIcon)
  217.         ReturnVal = True
  218.         Else
  219.         ReturnVal = DefWindowProc((Msg2.hWndTarget), MsgVal, wParam, lParam)
  220.         End If
  221.  
  222.     End Select
  223.  
  224.  
  225. End Sub
  226.  
  227. Sub Msg3_Message (MsgVal As Integer, wParam As Integer, lParam As Long, ReturnVal As Long)
  228.     '  copyright 1994 Ed Staffin
  229.     Const HTCLIENT = 1
  230.     Dim rc%
  231.     
  232.     ' The IF statement checks to see if the DragIcon
  233.     ' property of your PicturBox was non-NULL, and that
  234.     ' the cursor is over the client area,
  235.     ' (low word of lParam == 1 when cursor is there).
  236.     ' If you leave off the "else" statement then the
  237.     ' cursor will not be appropriate for the borders or
  238.     ' caption.
  239.     
  240.     Select Case MsgVal
  241.     Case WM_SETCURSOR
  242.         If (LOWORD(lParam) = HTCLIENT) And (Picture3.DragIcon) Then
  243.         rc% = SetCursor(Picture3.DragIcon)
  244.         ReturnVal = True
  245.         Else
  246.         ReturnVal = DefWindowProc((Msg3.hWndTarget), MsgVal, wParam, lParam)
  247.         End If
  248.  
  249.     End Select
  250.  
  251.  
  252. End Sub
  253.  
  254.